home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d7
/
dial32.arc
/
DIAL.BAS
next >
Wrap
BASIC Source File
|
1989-04-25
|
35KB
|
1,469 lines
'Sun Apr 23, 1989 1:36:45 pm
'****************************************************************************
'* 04/15/89 VER 3.2 *
'* **** DIAL PHONE DIALER **** *
'* Written in *
'* QUICKBASIC 4.5 *
'* *
'* (c) 1989 by DAVID WESSON, PhD. 238 S. Quaker La. W.Hartford, CT 06119 *
'****************************************************************************
'
' $INCLUDE: 'dial.dec'
'
'========================== MAIN PROGRAM STARTS HERE ========================
initialize
readcommandline
menuroutine
goodbye
'======================= DECLARED SUBROUTINES START HERE ====================
SUB addnames
pagehead "DIRECTORY BUSINESS"
prompt "Enter Blank line or [Esc] to end input."
startrec = numrecs
DO
numrecs = numrecs + 1
d$(1) = "ADDING names and phone numbers to Directory."
d$(2) = "Enter NAME : " + STRING$(20, 254)
d$(3) = "Enter NUMBER: " + STRING$(15, 254)
d$(4) = "Use - hyphens for pauses only."
dialog 8, "ENTER NAMES"
COLOR back, fore
LOCATE 20, 33
keyin 20
IF in$ = "" OR in$ = esc$ THEN numrecs = numrecs - 1: EXIT DO
name$(numrecs) = UCASE$(in$)
IF in$ = "" OR in$ = esc$ THEN numrecs = numrecs - 1: EXIT DO
LOCATE 21, 33
keyin 15
number$(numrecs) = in$
IF in$ = "" OR in$ = esc$ THEN numrecs = numrecs - 1: EXIT DO
LOOP UNTIL numrecs = 480
IF numrecs = startrecs THEN EXIT SUB
sortdatafile
writedatafile
END SUB
SUB changedir
pagehead "CHANGE DIRECTORY"
IF phonelist$ = "" THEN
prompt "Enter filename of DIRECTORY: " + STRING$(12, 254)
COLOR fore, back
LOCATE 25, 48
keyin 25
IF in$ = "" OR in$ = esc$ THEN EXIT SUB
phonelist$ = in$
clearall
restart
END IF
datafile$ = path$ + phonelist$
phonelist$ = ""
checkdatafile
viewdir
END SUB
SUB checkdatafile
Check.for.datafile:
datafile = FREEFILE
OPEN datafile$ FOR RANDOM AS datafile
IF LOF(datafile) = 0 THEN
CLOSE datafile
KILL datafile$
prompt "No Directory file by that name found. Hit a key or button."
inbutton
makenewdir
END IF
CLOSE datafile
Check.Top.Line:
opendatafile
INPUT #datafile, v
IF v < 3.2 THEN
CLOSE #datafile
opendatafile
LINE INPUT #datafile, x$
tempfile = FREEFILE
OPEN tempfile$ FOR OUTPUT AS tempfile
WRITE #tempfile, version, port$, tone$, initial$, prefix$, path$, fore, back, high, freq, mouseon
WHILE NOT EOF(datafile)
LINE INPUT #datafile, l$
PRINT #tempfile, l$
WEND
CLOSE
KILL datafile$
NAME tempfile$ AS datafile$
LOCATE 15, 15: PRINT "New datafile format installed, reset port settings."
readdatafile
setport
END IF
CLOSE
readdatafile
END SUB
SUB checkinput
getmouse
SELECT CASE button
CASE 1: in$ = enter$
CASE 2: in$ = esc$
CASE ELSE: in$ = UCASE$(INKEY$)
END SELECT
END SUB
SUB clearall
pagehead ""
COLOR fore, back
VIEW PRINT 5 TO 24
CLS
VIEW PRINT
END SUB
SUB click
IF freq <> 0 THEN SOUND freq, 1
END SUB
SUB clock
row = CSRLIN
col = POS(0)
COLOR back, fore
LOCATE 1, 68: PRINT newtime$(TIME$)
LOCATE row, col
END SUB
SUB deletename
pagehead "DIRECTORY BUSINESS"
DO
prompt "Enter FULL or PARTIAL NAME to be deleted, or [Esc] to EXIT."
d$(2) = "Enter FULL or PARTIAL NAME: " + STRING$(20, 254)
dialog 5, "DELETE NAME"
LOCATE 20, 44
keyin 20
IF in$ = "" OR in$ = esc$ THEN EXIT DO
name$ = UCASE$(in$)
found = 0: x = 0
DO UNTIL x = numrecs
x = x + 1
IF LEFT$(UCASE$(name$(x)), LEN(name$)) = name$ THEN
LOCATE 20, 44: PRINT name$(x)
found = 1
prompt "Hit any key or left button to confirm delete, or [Esc] to ABORT."
inbutton
END IF
IF in$ = esc$ THEN EXIT SUB
name$(x) = name$(x + found)
number$(x) = number$(x + found)
LOOP
numrecs = numrecs - found
IF found = 0 THEN prompt "No listing by that name in Directory. Hit a key or button.": inbutton
LOOP
writedatafile
END SUB
SUB demondial
demon = 1
DO
try = try + 1
placecall
IF call$ = "" THEN EXIT DO
LOOP
try = 0
demon = 0
call$ = ""
dial$ = ""
END SUB
SUB dialheader
COLOR fore, back
LOCATE 2, 1
PRINT SPACE$(160);
LOCATE 3, 1
END SUB
SUB dialog (margin, head$)
COLOR high, fore
LOCATE 18, 10
PRINT SPACE$(30 - (LEN(head$) / 2)); head$; SPACE$(70 - POS(0))
COLOR back, fore
FOR x = 1 TO 4
LOCATE 18 + x, 9
PRINT CHR$(176); SPACE$(1 + margin); d$(x); SPACE$(70 - POS(0))
NEXT x
LOCATE 23, 9: PRINT STRING$(60, 176)
FOR x = 1 TO 4
d$(x) = ""
NEXT x
END SUB
SUB dirhead
a$ = SPACE$(22): LSET a$ = datafile$
b$ = SPACE$(15): LSET b$ = initial$
c$ = SPACE$(15): LSET c$ = prefix$
LOCATE 4, 1
COLOR back, fore
PRINT SPACE$(1); a$; dev$; port$; dev$;
PRINT tone$; dev$; b$; dev$; "* = "; c$; SPACE$(1)
COLOR fore, back
END SUB
FUNCTION dosvers
t1 = &H3000: t2 = 0: t3 = 0: t4 = 0
inregs.ax = t1: inregs.bx = t2: inregs.cx = t3: inregs.dx = t4
CALL interrupt(&H21, inregs, outregs)
t1 = outregs.ax: t2 = outregs.bx: t3 = outregs.cx: t4 = outregs.dx
al = t1 - ((FIX(t1 / 256)) * 256)
ah = FIX(t1 / 256)
dosvers = al + (ah / 100)
END FUNCTION
SUB editname
pagehead "DIRECTORY BUSINESS"
DO
found = 0
prompt "Enter FULL or UNIQUE PARTIAL NAME, or Blank or [Esc] to EXIT."
d$(1) = "NAME or PARTIAL NAME : " + STRING$(20, 254)
d$(3) = "NEW NAME or [Return] : " + STRING$(20, 254)
d$(4) = "NEW NUMBER or [Return] : " + STRING$(15, 254)
dialog 6, "EDIT DIRECTORY ENTRY"
LOCATE 19, 42
keyin 20
IF in$ = "" OR in$ = esc$ THEN EXIT DO
name$ = UCASE$(in$)
x = 0
DO UNTIL x = numrecs
x = x + 1
IF LEFT$(name$(x), LEN(name$)) = name$ THEN
LOCATE 19, 42: PRINT name$(x)
found = x
EXIT DO
END IF
LOOP
LOCATE 21, 42
keyin 20
IF in$ = esc$ THEN EXIT DO
newname$ = UCASE$(in$)
IF newname$ <> "" THEN name$(found) = newname$
LOCATE 22, 42
keyin 15
IF in$ = esc$ THEN EXIT DO
newnumber$ = UCASE$(in$)
IF newnumber$ <> "" THEN number$(found) = newnumber$
IF found = 0 THEN prompt "No listing by that name found. Hit a key or button.": inbutton
LOOP
sortdatafile
writedatafile
END SUB
SUB findname
IF LEFT$(name$, 1) = "*" THEN name$ = MID$(name$, 2): add$ = prefix$
IF VAL(LEFT$(name$, 1)) > 0 THEN
call$ = name$
dial$ = add$ + name$
hyphen
EXIT SUB
ELSE
FOR x = 1 TO numrecs
IF LEFT$(name$(x), LEN(name$)) = name$ THEN
call$ = name$(x)
dial$ = add$ + number$(x)
END IF
NEXT x
END IF
IF call$ = "" THEN prompt "No listing for that name found. Hit a key or button.": inbutton
hyphen
END SUB
SUB getbutton
DO
inbutton
IF in$ = enter$ THEN
SELECT CASE mrow
CASE 2
mousecommand
CASE 5 TO 24
mouseread
mousemove 2, 80
CASE 25
mousepage
END SELECT
END IF
LOOP UNTIL in$ <> ""
END SUB
SUB getmouse
mouse 3, button, x, y
mrow = INT(y / 8) + 1
mcol = INT(x / 8) + 1
END SUB
SUB getname
prompt "Enter * for Prefix Code, Name, Number, or [Esc] to EXIT."
d$(1) = "Enter NAME or UNIQUE PARTIAL NAME or"
d$(2) = "enter phone number using hyphen"
d$(3) = "for 2 second pause. * for PREFIX CODE."
d$(4) = "NAME: " + STRING$(20, 254)
dialog 10, "PLACE CALL"
LOCATE 22, 27
keyin 20
IF in$ = "" OR in$ = esc$ THEN EXIT SUB
IF VAL(in$) = 0 THEN
name$ = UCASE$(in$)
findname
ELSE call$ = in$
dial$ = in$
END IF
LOCATE 22, 27: PRINT call$
END SUB
SUB getsubletter
x = 0
DO
x = x + 1
IF in$ = LEFT$(sel$(sel, x), 1) THEN
subsel = x
in$ = enter$
EXIT DO
END IF
LOOP UNTIL x = totsubs
END SUB
SUB goodbye
hidemouse
COLOR 7, 0
CLOSE
CLS
END
END SUB
SUB hangup
dialheader
IF port = 0 THEN EXIT SUB
CLOSE port
OPEN port$ FOR OUTPUT AS port
FOR x = 1 TO 3
PRINT #port, "ATH0"
NEXT x
LOCATE 2, 1
COLOR high, back
PRINT "Modem hung-up."
COLOR fore, back
CLOSE port
END SUB
SUB header
LOCATE 1, 1
COLOR back, fore
PRINT SPACE$(80);
LOCATE 1, 1
COLOR high: PRINT " DIAL";
COLOR back, fore: PRINT " Phone Dialer v3.2"
LOCATE 1, 44: PRINT newdate$;
LOCATE 1, 68: PRINT newtime$(TIME$)
COLOR fore, back
END SUB
SUB helpscreen (page)
clearall
IF page = 2 THEN GOTO page2
pagehead "HELP WITH FULL SCREEN MODE"
PRINT ""
PRINT ""
PRINT " EXECUTE COMMANDS:"
PRINT " Use [LeftArrow] or [RightArrow] and hit [Return]"
PRINT " or hit any of the highlighted initial letters"
PRINT ""
PRINT " VIEW DIRECTORY:"
PRINT " [PgDn] View next page"
PRINT " [PgUp] View previous page"
PRINT " [Home] View first page"
PRINT " [End] View last page"
PRINT ""
PRINT " MOUSE CONTROL: Left Button = [Return] Right Button = [Esc] "
PRINT " Move cursor to command and click. Or move cursor to name"
PRINT " or number, then double click left button to dial."
PRINT " Click on page buttons on bottom line to page directory."
PRINT " Hit [Esc] at any time to cancel commands or EXIT program."
PRINT " Turn Mouse on or off inside Settings option on top menu."
prompt "Hit any key or button to continue."
inbutton
EXIT SUB
page2:
pagehead "DIAL COMMANDS FOR DOS LINE OPERATION"
PRINT ""
PRINT ""
PRINT " name Gets name from directory and dials its number."
PRINT " Uses full name or unique first part of name."
PRINT ""
PRINT " number Dialing a number not in the Directory."
PRINT ""
PRINT " @file Activates directory file other than default DIAL.DAT."
PRINT ""
PRINT " *number Dial prefix before number."
PRINT ""
PRINT " *name Dial prefix before number that goes with name."
PRINT ""
PRINT " When assigning phone numbers, insert hyphen for two second pause."
PRINT ""
PRINT " NOTE: This program assumes use of the Hayes command set.";
prompt "Hit any key or button to continue."
inbutton
END SUB
SUB hidemouse
mouse 2, 0, 0, 0
END SUB
SUB hyphen
IF LEFT$(dial$, 1) = "*" THEN dial$ = prefix$ + MID$(dial$, 2)
FOR d = 1 TO LEN(dial$)
IF MID$(dial$, d, 1) = "-" THEN
MID$(dial$, d, 1) = ","
END IF
NEXT d
END SUB
SUB inbutton
DO
clock
checkinput
LOOP UNTIL in$ <> ""
END SUB
SUB initialize
CLS
IF dosvers >= 3 THEN
IF mouseinstalled = 0 THEN mouseon = 0 ELSE mouseon = 1
ELSE mouseon = 0
END IF
LOCATE , , 0, 6, 7 'turns cursor off
version = 3.2
port$ = "COM1:"
tone$ = "TONE"
initial$ = "Q0 V1 X4 S0=0"
prefix$ = ""
path$ = ""
fore = 7
back = 0
high = 15
freq = 750
items = 7
menuarrays
setnames
datafile$ = "DIAL.DAT"
tempfile$ = "dial.tmp"
header
checkdatafile
mouseis mouseon
logfile$ = path$ + "dial.log"
END SUB
'---------------------- INPUT ANSWER FROM KEYBOARD ----------------------------
SUB keyin (length)
word$ = ""
inrow = CSRLIN: incol = POS(0): ch$ = CHR$(SCREEN(inrow, incol))
COLOR back + 16, fore: PRINT ch$; CHR$(29);
DO
dummy = 0
IF LEN(word$) = 1 AND length = 1 THEN in$ = enter$ ELSE inbutton
SELECT CASE in$
CASE enter$
COLOR back, fore
IF LEN(word$) < length THEN PRINT ch$;
in$ = word$
EXIT DO
CASE esc$
in$ = esc$
EXIT DO
CASE bksp$ 'bksp and blank out answer
IF word$ <> "" THEN
COLOR back, fore
IF LEN(word$) <> length THEN PRINT CHR$(254); ELSE PRINT CHR$(0);
COLOR back + 16, fore
PRINT CHR$(29); CHR$(29); CHR$(254); CHR$(29);
word$ = LEFT$(word$, LEN(word$) - 1)
END IF
CASE ELSE
IF LEN(word$) = length THEN
click
ELSE
LOCATE inrow, incol
word$ = word$ + in$
PRINT word$;
IF LEN(word$) <> length THEN
COLOR back + 16, fore
PRINT CHR$(254); CHR$(29);
END IF
END IF
END SELECT
LOOP
END SUB
SUB logcall
IF call$ = "" THEN EXIT SUB
LOCATE 3, 1
COLOR high, back
PRINT "When phone is answered, hit L to LOG call, or any key or button to EXIT."
COLOR fore, back
inbutton
IF in$ <> "L" THEN EXIT SUB
openlogfile
ontime$ = newtime$(TIME$)
onhour = VAL(hour$)
onmin = VAL(min$)
onsec = VAL(sec$)
d$(2) = "At end of call, hit any key or button to log time."
d$(3) = " Elapsed Time: 00:00"
dialog 5, "LOG CALL"
start = TIMER
timeout
prompt "Call to " + call$ + " logged in DIAL.LOG."
PRINT #logfile, newdate$, LEFT$(call$, 12), dial$, ontime$, offtime$, tottime$
CLOSE logfile
END SUB
SUB mainscreen
header
viewdir
END SUB
SUB makenewdir
pagehead "DIRECTORY"
d$(1) = "This utility makes a new phone directory. Enter"
d$(2) = "a name for the new directory. If an existing"
d$(3) = "filename is specified, that file will be DELETED."
d$(4) = "Use DIAL.DAT only to make a new default directory."
dialog 5, "MAKE NEW DIRECTORY"
prompt "Enter filename: " + STRING$(12, 254)
COLOR back, fore
LOCATE 25, 42
keyin 12
IF in$ = "" OR in$ = esc$ THEN datafile$ = "DIAL.DAT": EXIT SUB
restart
datafile$ = in$
IF datafile$ = "DIAL.DAT" THEN
LOCATE 7, 1
COLOR fore, back
PRINT "============================================================================"
COLOR high
PRINT "WARNING: ";
COLOR fore
PRINT "If you proceed with this, existing DIAL.DAT file will be replaced."
PRINT " Hit [Esc] to EXIT or any key to continue."
PRINT "============================================================================"
prompt "Continuing will replace existing default Directory. Hit [Esc] to EXIT."
inbutton
IF in$ = esc$ THEN goodbye
ELSE datafile$ = path$ + datafile$
END IF
numrecs = 0
addnames
END SUB
SUB menuarrays
'======= Define Top Slide Bar Menu
sel$(1, 0) = "Place call"
sel$(2, 0) = "Directory"
sel$(3, 0) = "Change dir"
sel$(4, 0) = "Modem hang up"
sel$(5, 0) = "Settings"
sel$(6, 0) = "Help"
sel$(7, 0) = "Exit"
'===== Define Help messages for line 3
sel$(1, 10) = "Place and log call, Demon dial call "
sel$(2, 10) = "Add, edit and delete names and numbers "
sel$(3, 10) = "Change directory file, make a new directory file "
sel$(4, 10) = "Hang up modem line "
sel$(5, 10) = "Set colors, beep, mouse, port, dial type, default path and prefix code "
sel$(6, 10) = "Help with DOS commands and with this screen "
sel$(7, 10) = "Exit from this program "
'===== Define Sub Selections For Menu Items NOTE: each submenu item is same length
sel$(1, 1) = "Place call"
sel$(1, 2) = "Demon dial"
sel$(2, 1) = "Add names + #s"
sel$(2, 2) = "Edit name + #s"
sel$(2, 3) = "Delete name "
sel$(3, 1) = "Change dir "
sel$(3, 2) = "Make new dir"
sel$(4, 1) = "Hang up modem now"
sel$(5, 1) = "Port "
sel$(5, 2) = "Color"
sel$(5, 3) = "Sound"
sel$(5, 4) = "Mouse"
sel$(5, 5) = "DPath"
sel$(6, 1) = "Full Screen"
sel$(6, 2) = "DOS Command"
sel$(7, 1) = "EXIT NOW"
END SUB
SUB menufindcol
col = 1
FOR x = 1 TO sel - 1
col = col + LEN(sel$(x, 0)) + 2
NEXT x
END SUB
SUB menuhighlight
COLOR high, fore
LOCATE lin, col
PRINT SPACE$(1); LEFT$(sel$(sel, subsel), 1);
COLOR back, fore
PRINT MID$(sel$(sel, subsel), 2); SPACE$(1);
COLOR fore, back
LOCATE 3, 1: PRINT sel$(sel, 10)
END SUB
SUB menuinput
menutopline
menutoploop 'gets first menu command
IF sel = 0 THEN EXIT SUB 'if escape is passed then exit
hidemouse
DO
menufindcol
subwindow
mousewindow 74, 80, 4, totsubs + 3
DO 'gets second menu command
lin = subsel + 3
mousemove lin, 77
subhighlight
subbutton
menufindcol
menuhighlight
getsubletter
SELECT CASE in$ 'analyzes keystrokes
CASE esc$
showmouse
EXIT SUB
CASE enter$
showmouse
sel = (sel * 10) + subsel
EXIT SUB
CASE lft$
subsel = 1
sel = sel - 1
IF sel < 1 THEN sel = items
menufindcol
EXIT DO
CASE rght$
subsel = 1
sel = sel + 1
IF sel > items THEN sel = 1
menufindcol
EXIT DO
CASE up$
subsel = subsel - 1
IF subsel < 1 THEN subsel = 1
CASE down$
subsel = subsel + 1
IF subsel > totsubs THEN subsel = totsubs
CASE end$
subsel = totsubs
CASE home$
subsel = 1
END SELECT
LOOP
viewdir 'refreshes screen, erase window
LOOP
END SUB
SUB menuletter
FOR x = 1 TO items
IF in$ = LEFT$(sel$(x, 0), 1) THEN
sel = x
in$ = enter$
END IF
NEXT x
menufindcol
END SUB
SUB menuroutine
DO
mainscreen
menuinput
mousewindow 1, 80, 2, 25
IF sel <> 0 AND sel <> 61 THEN viewdir
SELECT CASE sel
CASE 0: EXIT DO 'escape key
CASE 11: placecall
CASE 12: demondial
CASE 21: addnames
CASE 22: editname
CASE 23: deletename
CASE 31: changedir
CASE 32: makenewdir
CASE 41: hangup
CASE 51: setport
CASE 52: setcolor
CASE 53: setsound
CASE 54: setmouse
CASE 55: setdpath
CASE 61: helpscreen 1
CASE 62: helpscreen 2
CASE 71: EXIT DO
CASE ELSE: click
END SELECT
LOOP
END SUB
SUB menutopline
col = 1
sel = 1
subsel = 0
lin = 2
FOR x = 1 TO items 'prints top menu line
sel = x
menuunhighlight
col = col + LEN(sel$(sel, 0)) + 2
NEXT
col = 1
sel = 1
menuhighlight 'highlights first menu item
showmouse
END SUB
SUB menutoploop
DO
getbutton
menufindcol
menuunhighlight
menuletter
SELECT CASE in$
CASE esc$
sel = 0
EXIT DO
CASE enter$, down$
EXIT DO
CASE rght$
col = col + LEN(sel$(sel, 0)) + 2
sel = sel + 1
IF sel > items THEN sel = 1: col = 1
CASE lft$
col = col - LEN(sel$(sel - 1, 0)) - 2
sel = sel - 1
IF sel < 1 THEN sel = items: menufindcol
CASE pgup$
IF dirpage = 0 THEN
click
ELSE dirpage = dirpage - 40
IF dirpage < 0 THEN dirpage = 0
viewdir
END IF
CASE pgdn$
IF dirpage = 440 OR dirpage >= numrecs - 40 THEN
click
ELSE dirpage = dirpage + 40
viewdir
END IF
CASE home$
IF dirpage > 0 THEN
dirpage = 0
viewdir
ELSE click
END IF
CASE end$
IF dirpage = 440 OR dirpage >= numrecs - 40 THEN
click
ELSE dirpage = numrecs - 40
viewdir
END IF
CASE ELSE
click
END SELECT
menuhighlight
LOOP
END SUB
SUB menuunhighlight
LOCATE lin, col
COLOR high, back
PRINT SPACE$(1); LEFT$(sel$(sel, subsel), 1);
COLOR fore, back
PRINT MID$(sel$(sel, subsel), 2); SPACE$(1);
END SUB
SUB mouse (m1, m2, m3, m4)
IF mouseon = 0 THEN EXIT SUB
inregs.ax = m1
inregs.bx = m2
inregs.cx = m3
inregs.dx = m4
CALL interrupt(51, inregs, outregs)
m1 = outregs.ax
m2 = outregs.bx
m3 = outregs.cx
m4 = outregs.dx
END SUB
SUB mousecommand
SELECT CASE mcol
CASE 1 TO 12: in$ = "P"
CASE 13 TO 23: in$ = "D"
CASE 24 TO 35: in$ = "C"
CASE 36 TO 50: in$ = "M"
CASE 51 TO 60: in$ = "S"
CASE 61 TO 67: in$ = "H"
CASE 68 TO 73: in$ = "E"
CASE ELSE: click
END SELECT
END SUB
FUNCTION mouseinstalled
m = 0 ' reset function
mouse m, n, 0, 0 ' returns M = 0 if no mouse installed
mouseinstalled = m
END FUNCTION
SUB mouseis (mouseon)
IF mouseon = 0 THEN m = 2 ELSE m = 1
mouse m, 1, 0, 0
mousewindow 1, 80, 2, 25
mousemove 2, 80
END SUB
FUNCTION mousemotion
IF mouseon = 0 THEN EXIT FUNCTION
getmouse
SELECT CASE mrow
CASE IS > lin: m = 1
CASE IS < lin: m = -1
CASE ELSE: m = 0
END SELECT
SELECT CASE mcol
CASE IS < 75: m = -2
CASE IS > 79: m = 2
END SELECT
mousemotion = m
END FUNCTION
SUB mousemove (mrow, mcol)
y = (mrow - 1) * 8: x = (mcol - 1) * 8
mouse 4, button, x, y
END SUB
SUB mousepage
SELECT CASE mcol
CASE 2 TO 12
in$ = "H"
CASE 23 TO 28
in$ = home$
CASE 31 TO 35
in$ = end$
CASE 38 TO 43
in$ = pgup$
CASE 45 TO 51
in$ = pgdn$
CASE 67 TO 76
in$ = esc$
CASE ELSE
click
END SELECT
END SUB
SUB mouseread
IF mcol > 40 THEN mcol = 41 ELSE mcol = 1
entry$ = ""
FOR x = mcol TO mcol + 36
entry$ = entry$ + CHR$(SCREEN(mrow, x))
NEXT x
LOCATE mrow, mcol
COLOR back, fore
PRINT entry$;
call$ = LTRIM$(RTRIM$(LEFT$(entry$, 20)))
dial$ = LTRIM$(RTRIM$(MID$(entry$, 22, 15)))
hyphen
in$ = "P"
END SUB
SUB mousewindow (left, right, top, bottom)
l = (left - 1) * 8: IF l < 0 THEN l = 0
r = (right - 1) * 8: IF r > 632 THEN r = 632
t = (top - 1) * 8: IF t < 0 THEN t = 0
b = (bottom - 1) * 8: IF b > 192 THEN b = 192
mouse 7, 0, l, r
mouse 8, 0, t, b
END SUB
FUNCTION newdate$
day$(0) = "Sunday"
day$(1) = "Monday"
day$(2) = "Tuesday"
day$(3) = "Wednesday"
day$(4) = "Thursday"
day$(5) = "Friday"
day$(6) = "Saturday"
month$(1) = "Jan"
month$(2) = "Feb"
month$(3) = "Mar"
month$(4) = "Apr"
month$(5) = "May"
month$(6) = "Jun"
month$(7) = "Jul"
month$(8) = "Aug"
month$(9) = "Sep"
month$(10) = "Oct"
month$(11) = "Nov"
month$(12) = "Dec"
t1 = &H2A00: t2 = 0: t3 = 0: t4 = 0
inregs.ax = t1: inregs.bx = t2: inregs.cx = t3: inregs.dx = t4
CALL interrupt(&H21, inregs, outregs)
t1 = outregs.ax: t2 = outregs.bx: t3 = outregs.cx: t4 = outregs.dx
day = t1 - ((FIX(t1 / 256)) * 256)
day$ = day$(day)
year = t3
year$ = LTRIM$(RTRIM$(STR$(year)))
month = FIX(t4 / 256)
month$ = month$(month)
date = t4 - (month * 256)
newdate$ = day$ + SPACE$(2) + month$ + STR$(date) + "," + STR$(year)
END FUNCTION
FUNCTION newtime$ (oldtime$)
hour$ = LEFT$(oldtime$, 2)
min$ = MID$(oldtime$, 4, 2)
sec$ = RIGHT$(oldtime$, 2)
hour = VAL(hour$)
IF hour < 12 THEN ampm$ = "am" ELSE ampm$ = "pm"
IF hour > 12 THEN hour = hour - 12
hour$ = STR$(hour)
newtime$ = hour$ + ":" + min$ + ":" + sec$ + " " + ampm$
END FUNCTION
SUB opendatafile
datafile = FREEFILE
OPEN datafile$ FOR INPUT AS datafile
END SUB
SUB openlogfile
logfile = FREEFILE
OPEN logfile$ FOR APPEND AS logfile
END SUB
SUB openport
port = FREEFILE
OPEN port$ FOR RANDOM AS port
END SUB
SUB pagehead (page$)
LOCATE 4, 1
COLOR back, fore
PRINT STRING$(80, 32);
LOCATE 4, 41 - (LEN(page$) / 2)
COLOR high, fore
PRINT page$;
COLOR fore, back
END SUB
SUB placecall
pagehead "PLACE CALL"
IF call$ = "" THEN viewdir: getname
IF call$ = "" THEN EXIT SUB
mainscreen
dialheader
LOCATE 2, 1
COLOR high, back
IF demon = 1 THEN
PRINT "DEMON-DIALING your call to "; call$; ", "; dial$; ". TRY"; try
PRINT "Hit any key or button to exit DEMON DIAL when connected."
END IF
IF demon = 0 THEN
IF call$ = dial$ THEN
PRINT "Your call to "; call$; " is dialing."
ELSE PRINT "Your call to "; call$; ", "; dial$; " is dialing."
END IF
PRINT "Wait for RING signal, then hit any key or button to HANG UP modem."
END IF
checkinput
IF in$ <> "" THEN EXIT SUB
openport
t$ = LEFT$(tone$, 1)
PRINT #port, "AT " + initial$ + " D" + t$ + dial$
DO
clock
checkinput
IF in$ <> "" THEN hangup: call$ = "": EXIT SUB
income = LOC(port)
IF income <> 0 THEN modem$ = INPUT$(1, #port)
SELECT CASE modem$
CASE "B"
hangup
IF demon = 1 THEN EXIT SUB
d$(1) = "Hit [SpaceBar] or Left Button to redial once,"
d$(2) = " or [D] to demon-dial call until it connects,"
d$(3) = " or any other key or Right Button to exit."
dialog 5, "BUSY SIGNAL"
prompt ""
inbutton
SELECT CASE in$
CASE CHR$(32), enter$
placecall
CASE "D"
demondial
EXIT DO
CASE ELSE
EXIT SUB
END SELECT
CASE "E"
dialheader
LOCATE 2, 1
PRINT "ERROR: Something wrong trying to dial out. Hit a key or button."
inbutton
EXIT SUB
CASE "R"
EXIT DO
CASE ELSE
dummy = 0
END SELECT
LOOP
ring
hangup
logcall
add$ = ""
call$ = ""
END SUB
SUB prompt (msg$)
LOCATE 25, 1
COLOR back, high
PRINT SPACE$(80);
t = INT((80 - LEN(msg$)) / 2)
LOCATE 25, t: PRINT msg$;
COLOR fore, back
END SUB
SUB qsort (srtn(), mid)
DIM newname$(numrecs), newnumber$(numrecs), newsrtn(numrecs)
y = 0: z = 0
FOR x = 1 TO numrecs
IF srtn(x) > mid THEN
newsrtn(numrecs - y) = srtn(x)
newname$(numrecs - y) = name$(x)
newnumber$(numrecs - y) = number$(x)
y = y + 1
ELSE newsrtn(z + 1) = srtn(x)
newname$(z + 1) = name$(x)
newnumber$(z + 1) = number$(x)
z = z + 1
END IF
NEXT x
FOR t = 1 TO numrecs
name$(t) = newname$(t)
number$(t) = newnumber$(t)
srtn(t) = newsrtn(t)
NEXT t
ERASE newname$, newnumber$, newsrtn
num$ = SPACE$(4)
LSET num$ = STR$(numrecs)
prompt "Total Names:" + num$ + SPACE$(10) + "Sorting #:"
COLOR back, fore
FOR x = 1 TO y
FOR w = 1 TO z - x
IF srtn(x) > srtn(x + w) THEN
SWAP srtn(x), srtn(x + w)
SWAP name$(x), name$(x + w)
SWAP number$(x), number$(x + w)
END IF
NEXT w
LOCATE 25, 58: PRINT x;
NEXT x
FOR x = y - 1 TO numrecs
FOR y = 1 TO numrecs - x
IF srtn(x) > srtn(x + y) THEN
SWAP srtn(x + y), srtn(x)
SWAP name$(x + y), name$(x)
SWAP number$(x + y), number$(x)
END IF
NEXT y
LOCATE 25, 58: PRINT x;
NEXT x
COLOR fore, back
END SUB
SUB readcommandline
inline$ = UCASE$(COMMAND$)
IF inline$ = "MAKE" THEN
makenewdir
inline$ = ""
END IF
IF inline$ = "" THEN EXIT SUB
rerun:
mark$ = LEFT$(inline$, 1)
SELECT CASE mark$
CASE "@"
phonelist$ = MID$(inline$, 2)
restart
changedir
EXIT SUB
CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
call$ = add$ + inline$
dial$ = add$ + inline$
CASE ELSE
name$ = inline$
findname
END SELECT
hyphen
placecall
goodbye
END SUB
SUB readdatafile
opendatafile
numrecs = 0
INPUT #datafile, version, port$, tone$, initial$, prefix$, path$, fore, back, high, freq, mouseon
WHILE NOT EOF(datafile)
numrecs = numrecs + 1
INPUT #datafile, name$(numrecs), number$(numrecs)
WEND
CLOSE datafile
END SUB
SUB restart
FOR x = 1 TO numrecs
name$(x) = ""
number$(x) = ""
NEXT x
END SUB
SUB ring
DO
LOCATE 3, 1
COLOR high, back
PRINT "Pick up the receiver, THEN hit any key or button to hang up modem."
FOR x = 1 TO 5
SOUND 850, .85
SOUND 650, .85
NEXT x
checkinput
IF in$ <> "" THEN EXIT DO
time1 = TIMER
DO
time2 = TIMER
LOCATE 3, 1
COLOR fore, back
PRINT "Pick up the receiver, THEN hit any key or button to hang up modem."
checkinput
IF in$ <> "" THEN EXIT SUB
LOOP UNTIL time2 = time1 + 4
LOOP
COLOR fore, back
END SUB
SUB setcolor
prompt "Hit [Return] to reset entry to original setting."
d$(1) = " Enter number for each color selection."
d$(3) = " 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15"
d$(4) = " FOREGROUND: " + STRING$(2, 254) + " BACKGROUND: " + STRING$(2, 254) + " HIGHLIGHT: " + STRING$(2, 254)
dialog 2, "SET COLORS"
LOCATE 20, 13
FOR x = 0 TO 9
COLOR x, 0: PRINT STRING$(3, 254);
NEXT x
FOR x = 10 TO 15
COLOR x, 0: PRINT STRING$(4, 254);
NEXT x
COLOR back, fore
LOCATE 22, 28
keyin 2
fore = VAL(in$)
IF fore = 0 THEN fore = 7
LOCATE 22, 45
keyin 2
back = VAL(in$)
IF back = fore THEN back = 0
LOCATE 22, 61
keyin 2
high = VAL(in$)
IF high = back THEN high = 15
writedatafile
mainscreen
END SUB
SUB setdpath
pagehead "SETTINGS"
d$(1) = "This setting option permits you to specify"
d$(2) = "the drive or suddirectory (path) for all files"
d$(3) = "that the program makes except DIAL DAT. Use the"
d$(4) = "full, exact pathname. Ex: A: or C:\utilities "
dialog 5, "SET DEFAULT PATH"
prompt "Enter full path: " + STRING$(18, 254)
COLOR back, fore
LOCATE 25, 39
keyin 18
IF in$ = "" OR in$ = esc$ THEN EXIT SUB
path$ = in$
IF LEN(in$) = 1 THEN
path$ = path$ + ":"
ELSEIF RIGHT$(path$, 1) <> ":" AND RIGHT$(path$, 1) <> "\" THEN
path$ = path$ + "\"
END IF
writedatafile
END SUB
SUB setmouse
d$(1) = "Mouse driver must be loaded and active before program"
d$(2) = "is loaded. Do not turn mouse on otherwise. In DOS 2.x"
d$(3) = "the program will hang if no mouse is present."
d$(4) = "Hit [Return] to turn Mouse on, [Esc] to turn Mouse off."
dialog 2, "SET MOUSE"
prompt "Hit [Return] to turn Mouse ON, [Esc] to turn Mouse OFF."
askm:
inbutton
SELECT CASE in$
CASE enter$
mouseis 1
mouseon = 1
CASE esc$
mouseis 0
mouseon = 0
CASE ELSE
GOTO askm
END SELECT
writedatafile
END SUB
SUB setnames
dev$ = CHR$(32) + CHR$(179) + CHR$(32)
esc$ = CHR$(27)
bksp$ = CHR$(8)
enter$ = CHR$(13)
up$ = CHR$(0) + CHR$(72)
pgup$ = CHR$(0) + CHR$(73)
pgdn$ = CHR$(0) + CHR$(81)
home$ = CHR$(0) + CHR$(71)
end$ = CHR$(0) + CHR$(79)
lft$ = CHR$(0) + CHR$(75)
rght$ = CHR$(0) + CHR$(77)
down$ = CHR$(0) + CHR$(80)
quote$ = CHR$(34)
comma$ = CHR$(44)
END SUB
SUB setport
pagehead "LINE SETTINGS"
d$(1) = "PORT NUMBER ( if in doubt, type 1 ) : " + port$
d$(2) = "DIALTONE TYPE ( T = Tone, P = Pulse ): " + tone$
d$(3) = "MODEM INITIALIZATION CODES (see docs): " + STRING$(14, 254)
d$(4) = "PREFIX CODE ( dials before a number) : " + STRING$(14, 254)
dialog 5, "SETTINGS"
prompt "Hit [Return] to keep settings the same."
COLOR back, fore
LOCATE 21, 55: PRINT initial$
LOCATE 22, 55: PRINT prefix$
LOCATE 19, 58
keyin 1
IF in$ = esc$ THEN EXIT SUB
IF in$ = "" THEN in$ = MID$(port$, 4, 1)
IF VAL(in$) < 0 OR VAL(in$) > 6 THEN goodbye
port$ = "COM" + in$ + ":"
asktype:
LOCATE 20, 55
keyin 1
SELECT CASE in$
CASE "T"
tone$ = "TONE"
CASE "P"
tone$ = "PULSE"
CASE ""
tone$ = tone$
CASE esc$
EXIT SUB
CASE ELSE
GOTO asktype
END SELECT
LOCATE 20, 55
PRINT tone$ + SPACE$(1)
LOCATE 21, 55
keyin 14
SELECT CASE in$
CASE "": initial$ = initial$
CASE esc$: EXIT SUB
CASE ELSE: initial$ = in$
END SELECT
LOCATE 22, 55
keyin 14
SELECT CASE in$
CASE "": prefix$ = prefix$
CASE esc$: EXIT SUB
CASE ELSE: prefix$ = in$
END SELECT
writedatafile
END SUB
SUB setsound
prompt "Enter NUMBER for desired sound frequency of beep."
d$(1) = "Select a sound frequency for the beep."
d$(2) = "HIGH MEDIUM LOW OFF"
d$(3) = " 1 2 3 4"
d$(4) = "NEW FREQUENCY: " + CHR$(254)
dialog 5, "SET SOUND"
LOCATE 22, 31
COLOR back, fore
getfreq:
inbutton
SELECT CASE VAL(in$)
CASE 1
freq = 3000
CASE 2
freq = 750
CASE 3
freq = 150
CASE 4
freq = 0
CASE ELSE
GOTO getfreq
END SELECT
PRINT in$
click
writedatafile
COLOR , fore, back
END SUB
SUB showlist
REDIM name$(481), number$(481)
readdatafile
clearall
viewdir
END SUB
SUB showmouse
mouse 1, 0, 0, 0
END SUB
SUB sortdatafile
prompt "Preparing to sort Directory."
x = 1
FOR x = 1 TO numrecs
srtn(x) = 0
FOR z = 1 TO 5
letter$ = MID$(name$(x), z, 1)
IF letter$ = "" OR letter$ < CHR$(65) OR letter$ > CHR$(90) THEN
srtn(x) = srtn(x) * 100
ELSE srtn(x) = (srtn(x) * 100) + (ASC(letter$) - 64)
END IF
NEXT z
stotal = stotal + srtn(x)
NEXT x
IF numrecs = 0 THEN EXIT SUB
mid = stotal / numrecs
qsort srtn(), mid
END SUB
SUB subbutton
DO
SELECT CASE mousemotion
CASE 1: in$ = down$
CASE -1: in$ = up$
CASE 2: in$ = rght$
CASE -2: in$ = lft$
CASE ELSE: checkinput
END SELECT
LOOP UNTIL in$ <> ""
IF sel = 1 AND button = 1 THEN inbutton
END SUB
SUB subhighlight
COLOR high, back
LOCATE lin, col
PRINT SPACE$(1); LEFT$(sel$(sel, subsel), 1); MID$(sel$(sel, subsel), 2); SPACE$(1);
END SUB
SUB subline
COLOR high, fore
LOCATE lin, col
PRINT SPACE$(1); LEFT$(sel$(sel, subsel), 1);
COLOR back, fore
PRINT MID$(sel$(sel, subsel), 2); SPACE$(1);
COLOR fore, back
PRINT CHR$(176);
LOCATE 3, 1: PRINT sel$(sel, 10)
END SUB
SUB subwindow
subsel = 1
DO UNTIL sel$(sel, subsel) = "" 'pulls down menu window
lin = subsel + 3
subline
subsel = subsel + 1
LOOP
LOCATE lin + 1, col + 1
PRINT STRING$(LEN(sel$(sel, 1)) + 2, 176)'prints bottom window shadow
totsubs = subsel - 1
subsel = 1
END SUB
SUB timeout
DO
checkinput
DO UNTIL sec >= start + 1
sec = TIMER
LOOP
start = start + 1
d1 = d1 + 1
IF d1 = 10 THEN
d2 = d2 + 1
d1 = 0
END IF
IF d2 = 6 THEN
d3 = d3 + 1
d2 = 0
END IF
IF d3 = 10 THEN
d4 = d4 + 1
d3 = 0
END IF
IF d4 = 10 THEN d4 = 0
d1$ = LTRIM$(STR$(d1)): d2$ = LTRIM$(STR$(d2))
d3$ = LTRIM$(STR$(d3)): d4$ = LTRIM$(STR$(d4)):
tottime$ = d4$ + d3$ + ":" + d2$ + d1$
LOCATE 21, 42: PRINT tottime$;
LOOP UNTIL in$ <> ""
offtime$ = newtime$(TIME$)
END SUB
SUB viewdir
dirhead
y = 1: w = 1
FOR x = 5 TO 24
z = z + 1
name1$ = SPACE$(20)
name2$ = SPACE$(20)
number1$ = SPACE$(15)
number2$ = SPACE$(15)
LSET name1$ = name$(z + dirpage)
LSET name2$ = name$(z + 20 + dirpage)
LSET number1$ = number$(z + dirpage)
LSET number2$ = number$(z + 20 + dirpage)
LOCATE x, 1: PRINT name1$; TAB(23); number1$; TAB(41); name2$; TAB(63); number2$;
NEXT x
prompt "[H] HELP [Home] [End] [PgUp] [PgDn] [Esc] EXIT"
END SUB
SUB writedatafile
prompt "Directory " + datafile$ + " modified."
datafile = FREEFILE
OPEN datafile$ FOR OUTPUT AS datafile
WRITE #datafile, version, port$, tone$, initial$, prefix$, path$, fore, back, high, freq, mouseon
FOR x = 1 TO numrecs
WRITE #datafile, name$(x), number$(x)
NEXT x
CLOSE datafile
END SUB
SUB writescreen (indent)
FOR x = 5 TO 24
IF NOT l$(x) = "" THEN
LOCATE x, indent: PRINT l$(x)
l$(x) = ""
END IF
NEXT x
END SUB